home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / utils / mailpost.el < prev    next >
Encoding:
Text File  |  1995-01-31  |  2.9 KB  |  96 lines
  1. ;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer
  2. ;; Keywords: mail
  3.  
  4. ;;
  5. ;; P O S T . E L
  6. ;;
  7. ;; Yet another mail interface.  this for the rmail system to provide
  8. ;;  the missing sendmail interface on systems without /usr/lib/sendmail,
  9. ;;   but with /usr/uci/post.
  10. ;;
  11. ;; created by: Gary Delp <delp at huey.Udel.Edu>
  12. ;;             Mon Jan 13 14:45:12 1986
  13. ;;
  14. ;;
  15.  
  16. ;; (setq send-mail-function 'post-mail-send-it)
  17.  
  18. (defun post-mail-send-it ()
  19.   "\
  20. the MH -post interface for rmail-mail to call.
  21. to use it, include (setq send-mail-function 'post-mail-send-it) in site-init."
  22.   (let ((errbuf (if mail-interactive
  23.             (generate-new-buffer " post-mail errors")
  24.           0))
  25.     (temfile "/tmp/,rpost")
  26.     (tembuf (generate-new-buffer " post-mail temp"))
  27.     (case-fold-search nil)
  28.     delimline
  29.     (mailbuf (current-buffer)))
  30.     (unwind-protect
  31.     (save-excursion
  32.       (set-buffer tembuf)
  33.       (erase-buffer)
  34.       (insert-buffer-substring mailbuf)
  35.       (goto-char (point-max))
  36.       ;; require one newline at the end.
  37.       (or (= (preceding-char) ?\n)
  38.           (insert ?\n))
  39.       ;; Change header-delimiter to be what post-mail expects.
  40.       (goto-char (point-min))
  41.       (search-forward (concat "\n" mail-header-separator "\n"))
  42.       (replace-match "\n\n")
  43.       (backward-char 1)
  44.       (setq delimline (point-marker))
  45.       (if mail-aliases
  46.           (expand-mail-aliases (point-min) delimline))
  47.       (goto-char (point-min))
  48.       ;; ignore any blank lines in the header
  49.       (while (and (re-search-forward "\n\n\n*" delimline t)
  50.               (< (point) delimline))
  51.         (replace-match "\n"))
  52.       ;; Find and handle any FCC fields.
  53.       (let ((case-fold-search t))
  54.         (goto-char (point-min))
  55.         (if (re-search-forward "^FCC:" delimline t)
  56.         (mail-do-fcc delimline))
  57.         ;; If there is a From and no Sender, put it a Sender.
  58.         (goto-char (point-min))
  59.         (and (re-search-forward "^From:"  delimline t)
  60.          (not (save-excursion
  61.             (goto-char (point-min))
  62.             (re-search-forward "^Sender:" delimline t)))
  63.          (progn
  64.            (forward-line 1)
  65.            (insert "Sender: " (user-login-name) "\n")))
  66.         ;; don't send out a blank subject line
  67.         (goto-char (point-min))
  68.         (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
  69.         (replace-match ""))
  70.         (if mail-interactive
  71.         (save-excursion
  72.           (set-buffer errbuf)
  73.           (erase-buffer))))
  74.       (write-file (setq temfile (make-temp-name temfile)))
  75.       (set-file-modes temfile 384)
  76.       (apply 'call-process
  77.          (append (list (if (boundp 'post-mail-program)
  78.                    post-mail-program
  79.                  "/usr/uci/lib/mh/post")
  80.                    nil errbuf nil
  81.                    "-nofilter" "-msgid")
  82.              (if mail-interactive '("-watch") '("-nowatch"))
  83.              (list temfile)))
  84.       (if mail-interactive
  85.           (save-excursion
  86.         (set-buffer errbuf)
  87.         (goto-char (point-min))
  88.         (while (re-search-forward "\n\n* *" nil t)
  89.           (replace-match "; "))
  90.         (if (not (zerop (buffer-size)))
  91.             (error "Sending...failed to %s"
  92.                (buffer-substring (point-min) (point-max)))))))
  93.       (kill-buffer tembuf)
  94.       (if (bufferp errbuf)
  95.       (switch-to-buffer errbuf)))))
  96.